
package Sgdb::Cntr::Annotate ;

use Sgdb::Utils qw( :DEFAULT
                    bind_search_mechanism
                    localconfig
                    get_scratch_directory
                    ) ;

use warnings ;
use strict ;
use integer ;
use bytes ;

my %recentable ;
init() ;

sub init {

    my  @monthes = qw/Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec/ ;
    my ($month, $year) = (localtime)[4, 5] ;
    $year -= 100 if $year > 100 ;
    # should I worry about bug 2100 ? well, I hope it would be someone else's problem
    for my $i (qw/1 1
                  2 2
                  3 3 3 3
                  4 4 4 4 4 4
                  /) {
        $recentable{ sprintf 'p %s-%02d' , $monthes[$month], $year } = "patch-$i" ;
        $recentable{ sprintf '%s-%02d' , $monthes[$month], $year } = "cvs-$i" ;
        if (-- $month < 0 ) {
            -- $year ;
            $month = $#monthes ;
        }
    }
#     use Data::Dumper ;
#     print Data::Dumper::Dumper( \%recentable ) ;
}

sub new {
    my ($self, $topf, $old, $file, $full ) = @_ ;

    my $t = $topf -> Scrolled('ROText', pref 'source-text' ) ;
    # copy text
    $t -> insert ( 'end' , $old->get( '1.0' => 'end') ) ;

    # copy tags
    foreach my $tag ($old -> tagNames() ) {
        my @ranges = $old -> tagRanges( $tag ) ;
        while ( @ranges ) {
            $t -> tagAdd ( $tag , splice @ranges, 0, 16) ;
        }
    }

    foreach my $mark     (        $old -> markNames  (     )) {
        $t -> markSet    ( $mark, $old -> index      ($mark)) ;
        $t -> markGravity( $mark, $old -> markGravity($mark)) ;
    }

    # annotate
    if ($t -> tagRanges('annotate') ) {
        $t -> tagConfigure('annotate', -elide => 0) ;
    }
    else {
        $file = get_dir_and_file( $file ) ;
        my $anno = get_annotation_file ($file) ;
        $anno or return telthemloud "can't annotate $file" ;
        $anno =~ /^Error/ and return telthemloud $anno ;
        add_annotation ($t, $file , $anno, $full) ;

        # more
    }
    Sgdb::SourcePane::nice_source_tags_for ( $t ) ;
    Sgdb::SourcePane::nice_popup_menu_for  ( $t ) ;
    bind_search_mechanism( $t ) ;
    add_nice_cvs_tags_to                   ( $t ) ;
    $t -> yviewMoveto( ($old -> yview )[0] || 0 ) ;

    $t -> pack ( -fill => 'both' ,
                 -expand => 1 ,
               ) ;
}

sub this {

    my ($self, $t, $file, $full ) = @_ ;
    return
      $t -> tagConfigure( 'annotate', -elide => 0 ) if
        $t -> tagRanges(  'annotate'  ) ;

    $file = get_dir_and_file( $file ) ;
    my $anno = get_annotation_file ($file) ;
    $anno or return telthemloud "can't annotate $file" ;
    $anno =~ /^Error/ and return telthemloud $anno ;
    add_annotation ($t, $file,  $anno, $full) ;

    add_nice_cvs_tags_to( $t ) ;
}

sub hide {
    my $self = shift ;
    my $t = shift ;
    $t -> tagConfigure( 'annotate', -elide => 1 ) ;
}

sub add_nice_cvs_tags_to {
    my $t = shift ;

    for my $tag (qw/cvs-error patch-temp cvs-unknown/,
                 map {("cvs-$_", "patch-$_")} (1 .. 5)
                ) { $t -> tagConfigure( $tag, pref "source-$tag-tag" ) }

    $t->tagRaise('e-search') ;
    $t->tagRaise( 'sel' ) ;
}

sub recentable($) {
    #   494:5.9          (adi      25-Jun-00):
    #       6.50         (rmargali 22-Jan-03): ....
    # 5772_10 31801,9 [byoder 06-Oct-06]
    # 5772_6 31833,1 (byoder 23-Sep-06):
    local $_ = shift ;
    /\d+\.\d+\s+\(\w+\s+\d\d-(\w\w\w\-\d\d)\)\s*:/            and return $recentable{ $1     } || "cvs-5"  ;
    /\d\d\d\d_\d+\s\d+,\d+\s\(\w+\s+\d\d-(\w\w\w-\d\d)\)\s*:/ and return $recentable{ "p $1" } || "patch-5";
    /\d\d\d\d_\d+\s\d+,\d+\s\[\w+\s+\d\d-(\w\w\w-\d\d)\]\s*:/ and return "patch-temp";
    'cvs-unknown' ;
}

sub get_dir_and_file {

    my ($file, $file_1, $file_2,  @sources) ;

    $file = shift or return ;

    if ( gdb_cached 'is-alive' ) {

        my $res = gdb_cached 'info-sources' ;

        unless ( $res ) {

            $res = gdb_cached 'info-sources' =>
              gdb_exec_quiet ('info sources', 25) ;

            unless ($res =~ /\w/ ) { # sync bug fix

                telme ("no sources, trying again ..") ;
                sleep 1 ;
                while ($res = gdb_exec_quiet ('') ) {
                    sleep 1 ;
                }
                                # and try again ..
                $res = gdb_cached 'info-sources' =>
                  gdb_exec_quiet ('info sources', 20) ;
            }
        }
        foreach my $line (split /^/, $res) {

            $line =~ /\w/ or next ;
            $line =~ /^\s*Source files/ and next ;
            chomp $line ;
            push @sources,  split /,\s*/, $line ;
        }
    }

    ($file_1) = grep ( /\b\Q$file/, @sources ) ;
    $file_1 ||= $file ;

    ($file_2) = $file_1 =~ m/^\.\.\/(.*)/ ;
    ($file_2 || $file_1) ;
}


sub get_annotation_file {

    my $source  = shift ;
    my $scratch = get_scratch_directory( "annotate" ) ;

    foreach my $dir ( @Sgdb::ServicePane::source_directories, './' ) {

        # Note: I trust @source_directories not to contain multi lines strings

        $dir =~ /\w/ or next ;
        my ($d, $e) = $dir =~ /^\s*(\S*)\s*\((.*)\)/ ;
        $d =~ s|/$|| if $d;

        if ( $e eq 'Syren' or $d =~ m{/emc/\w+/\.syren/} ) {
            my ($major, $minor, $fixes) = gdb_cached ('syren-v') =~ /\"(\d+)\s+(\d+)\s+(.*)\"/ ;
            $_ = localconfig 'get-syren-annotate', $scratch, $source, $major, $minor, $fixes ;
        }
        else {

            $d ||= $dir ;
            $d =~ s/\s+$// ;
            $_ = localconfig 'get-cvs-annotate'  , $source, $scratch, $d ;
        }

        if (/^Error/i) {
            telthem $_;
            return '';
        }
        return $_ if -f ;
    }

    '' ;
}

sub add_annotation {

    my ($t, $file, $anno, $full) = @_ ;
    open F, $anno or return telthemloud "can't open '$anno': $!" ;
    my @anno = <F>;
    close F ;

    # alling patch line
    my $max = 40 ;
    for (@anno) {
        /^(.*?:)/ or next ;
        $max = length $1 ;
        last ;
    }

    my $lno = "+5 c" ;
    for (my $i = 1 ; $i < @anno ; $i ++ ) {
        $lno = "+6 c" if $i > 9_999 ;

        # add annotation || fix number || '????'
        $anno[$i-1] =~ /(.*?:) (.*)/m or telme "what is '$_'?" ;
        my ($who, $what) = ($1, $2) ;
        unless ($what eq $t -> get("L$i $lno", "L$i lineend " ) ) {
            my $woo = " MISMATCH (annotation value)" ;
            $woo .= (' ' x ($max - 1 - length $woo )) . ':' ;
            $t -> insert ("L$i lineend",
                          "\n    :" => [qw/annotate regtext  /],
                          $woo      => [qw/annotate cvs-error/] ,
                          $what     => [qw/annotate          /]) ;
        }
        $t -> insert ("L$i $lno", $who => [annotate => recentable $who] ) ;
    }
}

1 ;
